home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbpcopy / jmdialog.bas < prev    next >
Encoding:
BASIC Source File  |  1998-10-04  |  1.9 KB  |  78 lines
  1. Attribute VB_Name = "JMDialog"
  2. Option Explicit
  3.  
  4. '
  5. '  Set Common Dialog Position
  6. Public Sub jmSetCommonDialogPosition(Action As Integer, ctlContl As Control)
  7. '
  8. '  Action is as follows :-
  9. '
  10. '    ShowOpen = 1
  11. '    ShowSave = 2
  12. '    ShowColor = 3
  13. '    ShowFont = 4
  14. '    ShowPrinter = 5
  15.     Dim wrkOffsetLeft As Integer
  16.     Dim wrkOffsetTop As Integer
  17. '
  18. '  Set Error Trap
  19.     On Error GoTo jmSetCommonDialogPositionError
  20. '
  21. '  Set Height and Width
  22.     MyCDForm.Width = 6000
  23.     MyCDForm.Height = 3600
  24. '
  25. '  Set Offset
  26.     wrkOffsetLeft = 0
  27.     wrkOffsetTop = 0
  28.     Select Case Action
  29.     Case 4
  30.         wrkOffsetLeft = -360
  31.         wrkOffsetTop = -1320
  32.     Case 5
  33.         wrkOffsetLeft = -840
  34.         wrkOffsetTop = -840
  35.     End Select
  36. '
  37. '  Set Top and Left
  38.     MyCDForm.Top = jmAbsoluteTop(ctlContl) + ctlContl.Height + wrkOffsetTop + 360
  39.     MyCDForm.Left = ctlContl.Parent.Left + wrkOffsetLeft + 240
  40. '
  41. '  Do Nothing if An Error
  42. jmSetCommonDialogPositionError:
  43.     Exit Sub
  44. End Sub
  45.  
  46. '
  47. '  Absolute Top Position Function
  48. Public Function jmAbsoluteTop(ctlContl As Control) As Single
  49.     Dim wrkContl As Control                     ' Working Control
  50.     Dim wrkTopPos As Single                     ' Calculated Top Position
  51. '
  52. '  Set Error Trap
  53.     On Error GoTo jmAbsoluteTopError
  54. '
  55. '  Initialise Working Control
  56.     Set wrkContl = ctlContl
  57. '
  58. '  Set Initial Top Position
  59.     wrkTopPos = 0
  60. '
  61. '  Loop until the Container is the Parent
  62.     Do
  63.         If (wrkContl.Container.Name = ctlContl.Parent.Name) Then Exit Do
  64.         wrkTopPos = wrkTopPos + wrkContl.Top    ' Calculate Top Position
  65.         Set wrkContl = wrkContl.Container       ' Set Next Control
  66.     Loop
  67. '
  68. '  Return Absolute Position
  69.     jmAbsoluteTop = wrkTopPos + ctlContl.Parent.Top
  70.     Exit Function
  71. '
  72. '  Return a Sensible Value if an Error
  73. jmAbsoluteTopError:
  74.     jmAbsoluteTop = ctlContl.Top + ctlContl.Parent.Top
  75.     Exit Function
  76. End Function
  77.  
  78.